home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / db3tech.arc / LABEL1.PRG < prev    next >
Encoding:
Text File  |  1985-11-01  |  2.7 KB  |  99 lines
  1. PROCEDURE Dolabel
  2. * Author ....: Luis Castro revised by Christopher White
  3. * Date ......: August 1, 1985
  4. * Version ...: dBASE III, any version
  5. * Note(s) ...: Prints more than one label across without
  6. *              printing a blank line when the Company field is
  7. *              blank.  Use a database file with the following
  8. *              structure.
  9. *
  10. *                       Name            Character       <any length>
  11. *                       Company         Character       <any length>
  12. *                       Address         Character       <any length>
  13. *                       City            Character       <any length>
  14. *                       State           Character       <any length>
  15. *                       Zip             Character       <any length>
  16. *
  17. PARAMETERS filename, ndx, condition, nacross, lablen, between, printer
  18. USE &filename
  19. IF "" <> indx
  20.    SET INDEX TO &indx
  21. ENDIF
  22. SET FILTER TO &condition
  23. GO TOP
  24. IF nacross > 4
  25.    nacross = 4
  26. ENDIF
  27. * ---Print labels.
  28. CLEAR
  29. DO WHILE .NOT. EOF()
  30.    * ---Store first column to output lines.
  31.    STORE "" TO line1, line2, line3, line4
  32.    DO Format WITH TRIM( Name ), line1
  33.    IF Company = "  "
  34.       DO Format WITH TRIM( Address ),line2
  35.       DO Format WITH TRIM( City ) + ", " + State + " " + Zip, line3
  36.       DO Format WITH " ", line4
  37.    ELSE
  38.       DO Format WITH TRIM( Company ), line2
  39.       DO Format WITH TRIM( Address ), line3
  40.       DO Format WITH TRIM( City ) + ", " + State + " " + Zip, line4
  41.    ENDIF
  42.    * ---Store rest of columns to output lines.
  43.    IF nacross > 1
  44.       SKIP
  45.    ENDIF
  46.    column = 1
  47.    DO WHILE .NOT. EOF() .AND. column < nacross
  48.       DO Format WITH TRIM( Name ),line1
  49.       IF Company = "  "
  50.          DO Format WITH TRIM( Address ),line2
  51.          DO Format WITH TRIM( City ) + ", " + State + " " + Zip, line3
  52.          DO Format WITH " ", line4
  53.       ELSE
  54.          DO Format WITH TRIM( Company ), line2
  55.          DO Format WITH TRIM( Address ), line3
  56.          DO Format WITH TRIM( City ) + ", " + State + " " + Zip, line4
  57.       ENDIF
  58.       column = column + 1
  59.       IF column < nacross
  60.          SKIP
  61.       ENDIF
  62.    ENDDO
  63.    * ---Print output line.
  64.    IF printer = "Y"
  65.       SET CONSOLE OFF
  66.       SET PRINT ON
  67.    ENDIF
  68.    ? line1
  69.    ? line2
  70.    ? line3
  71.    ? line4
  72.    ?
  73.    ?
  74.    IF printer = "Y"
  75.       SET PRINT OFF
  76.       SET CONSOLE ON
  77.    ENDIF
  78.    IF .NOT. EOF()
  79.       SKIP
  80.    ENDIF
  81. ENDDO
  82. CLOSE DATABASE
  83. RETURN
  84. * EOP Dolabel
  85.  
  86. PROCEDURE Format
  87. PARAMETERS exp, pline
  88. fstring = SUBSTR( exp,1,lablen )
  89. DO CASE
  90.    CASE " " = exp
  91.      fstring = SPACE( lablen )
  92.    CASE LEN( fstring ) < lablen
  93.      fstring = fstring + SPACE( lablen - LEN( exp ))
  94. ENDCASE
  95. fstring = fstring + SPACE( between )
  96. pline   = pline + fstring
  97. RETURN
  98. * EOP Format
  99.